home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / soundu / dilaudid.zip / NEW / DG.BAS < prev    next >
BASIC Source File  |  1994-03-28  |  43KB  |  1,392 lines
  1. DEFINT A-Z
  2. DECLARE FUNCTION words (text$)
  3. DECLARE FUNCTION BuildChord$ (croot, ctype)
  4. DECLARE FUNCTION GetNotes$ (starttime, endtime)
  5. DECLARE FUNCTION GetWord$ (orig$, wordno)
  6. DECLARE FUNCTION Modify (initial, change, irlo, irhi, degree)
  7. DECLARE FUNCTION Note2Num (note$)
  8. DECLARE FUNCTION Num2Note$ (number)
  9. DECLARE FUNCTION Round$ (initial$, newnote1$, scaletype, size)
  10. DECLARE FUNCTION ScaleNum (initial, irlo, irhi, orlo, orhi, inv)
  11. DECLARE FUNCTION Trim$ (orig$)
  12. DECLARE SUB Arpeg ()
  13. DECLARE SUB ViewComp ()
  14. DECLARE SUB Life ()
  15. DECLARE SUB Quit ()
  16. DECLARE SUB Add ()
  17. DECLARE SUB Load ()
  18. DECLARE SUB Save ()
  19. DECLARE SUB Cellular ()
  20. DECLARE SUB Move ()
  21. DECLARE SUB DeleteNotes ()
  22. DECLARE SUB SaveText (filename$)
  23. DECLARE SUB RandomNotes ()
  24. DECLARE SUB Generate ()
  25. DECLARE SUB Wave ()
  26. DECLARE SUB Mountain ()
  27.  
  28. COMMON SHARED notes()
  29. DIM SHARED notes(1 TO 11, 1 TO 3, 0 TO 700)
  30.  
  31. 'how notes are stored:
  32. '  (1) they are stored in the notes array,
  33. '  (2) notes has three subscripts:
  34. '      (a) 1 to 11:  specifies channel number
  35. '      (b) 1 to 2:   1 is the note's time location,
  36. '                    2 is the note frequency number
  37. '                    3 is the note duration
  38. '      (c) 1 to 500: are the notes themselves,
  39. '                    0 is the top note number
  40.  
  41. 'when notes are added, check to if they go before any notes that are
  42. 'already present. if so, move those notes first so that the whole array
  43. 'stays in order.
  44.  
  45.     FOR r = 1 TO 11
  46.         notes(r, 1, 0) = 0
  47.     NEXT
  48.  
  49.  
  50. start:
  51.     CLS
  52.     PRINT "Dilaudid Glide"
  53.     PRINT "Music Authoring System"
  54.     PRINT STRING$(80, "-")
  55.     PRINT
  56.     PRINT " 1. View composition"
  57.     PRINT " 2. Play composition/Adlib"
  58.     PRINT " 3. Add notes"
  59.     PRINT " 4. Generate pattern"
  60.     PRINT " 5. Delete notes"
  61.     PRINT " 6. Move notes"
  62.     PRINT
  63.     PRINT " 7. Load sequence"
  64.     PRINT " 8. Save sequence"
  65.     PRINT " 9. Save text"
  66.     PRINT "10. Quit"
  67.     PRINT
  68.     LINE INPUT "-->", x$
  69.  
  70.     sel = VAL(x$)
  71.     SELECT CASE sel
  72.         CASE 1  'view composition
  73.             ViewComp
  74.         CASE 2  'play composition
  75.             SaveText "SEQ.TXT"
  76.             SHELL "PLAY SEQ.TXT"
  77.         CASE 3  'add notes
  78.             Add
  79.         CASE 4  'generate pattern
  80.             Generate
  81.         CASE 5  'delete notes
  82.             DeleteNotes
  83.         CASE 6  'move notes
  84.             Move
  85.         CASE 7  'load sequence
  86.             Load
  87.         CASE 8  'save sequence
  88.             Save
  89.         CASE 9  'save as text
  90.             SaveText ""
  91.         CASE 10 'quit
  92.             Quit
  93.     END SELECT
  94.     GOTO start
  95.  
  96. SUB Add
  97.     'Add a section of notes
  98.  
  99.     CLS
  100.     PRINT "Dilaudid Glide"
  101.     PRINT "Music Authoring System             (  X: X" + CHR$(34) + " X' X x x' x" + CHR$(34) + " x: x; x= x* )"
  102.     PRINT STRING$(80, "-")
  103.     PRINT ".NOT files are text note lists, .CEL files are binary information lists"
  104.     PRINT
  105.  
  106.     x$ = DIR$("*.CEL")
  107.     IF x$ <> "" THEN
  108.         PRINT x$,
  109.         DO
  110.             x$ = DIR$
  111.             IF x$ = "" THEN EXIT DO
  112.             PRINT x$,
  113.         LOOP
  114.     END IF
  115.     x$ = DIR$("*.NOT")
  116.     IF x$ <> "" THEN
  117.         PRINT x$,
  118.         DO
  119.             x$ = DIR$
  120.             IF x$ = "" THEN EXIT DO
  121.             PRINT x$,
  122.         LOOP
  123.     END IF
  124.  
  125.     PRINT
  126.     PRINT
  127.     LINE INPUT "Channel # ---------->", channel$
  128.     LINE INPUT "Main filename ------>", filename$
  129.     IF UCASE$(RIGHT$("   " + filename$, 3)) <> "NOT" THEN
  130.         LINE INPUT "Note range start --->", notestart$
  131.         LINE INPUT "Note range end ----->", noteend$
  132.     ELSE
  133.         notestart$ = "C": noteend$ = "c"
  134.     END IF
  135.         '   SCALE TYPES
  136.         '   -----------
  137.     PRINT "    '0=chromatic"
  138.     PRINT "    '1=whole tone starting on C"
  139.     PRINT "    '2=whole tone starting on C+"
  140.     PRINT "    '3=diatonic/c-major"
  141.     PRINT "    '4=spooky"
  142.     PRINT "    '5=black keys"
  143.     PRINT "    '6=indian"
  144.     LINE INPUT "Scale type (0-6) --->", scaletype$
  145.     scaletype = VAL(scaletype$)
  146.     LINE INPUT "Rounding buffer ---->", size$
  147.     size = VAL(size$)
  148.     LINE INPUT "Spacing style (ox) ->", spacing$
  149.     IF spacing$ = "" THEN
  150.         LINE INPUT "Note length (16ths)->", notelen$
  151.         notelen = VAL(notelen$)
  152.     ELSE
  153.         LINE INPUT "Spacing repeats ---->", spacerep$
  154.     END IF
  155.     LINE INPUT "Time place start --->", timestart$
  156.     timestart = ((VAL(timestart$) - 1) * 16) + 1
  157.     IF timestart = 0 THEN timestart = 1
  158.     IF spacing$ = "" THEN
  159.         LINE INPUT "Time length -------->", timelen$
  160.         timelen = VAL(timelen$) * 16
  161.     END IF
  162.     LINE INPUT "# repeats ---------->", repeats$
  163.     repeats = VAL(repeats$)
  164.     IF repeats = 0 THEN repeats = 1
  165.     LINE INPUT "Degree variation --->", degreev$
  166.     degreev = VAL(degreev$)
  167.     LINE INPUT "Repeat filename ---->", rfilename$
  168.     PRINT
  169.     LINE INPUT "Proceed? (y/N) ----->", x$
  170.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  171.  
  172.     channel = VAL(channel$)
  173.     IF channel < 1 THEN channel = 1
  174.     IF channel > 11 THEN channel = 11
  175.     notestart = Note2Num(notestart$)
  176.     noteend = Note2Num(noteend$)
  177.  
  178.     'get number of notes / repeated section
  179.  
  180.     IF spacing$ <> "" THEN
  181.         spacing$ = Trim$(spacing$)
  182.         numnotesb = words(spacing$)
  183.         spacerep = VAL(spacerep$)
  184.         numnotes = spacerep * numnotesb
  185.     ELSE
  186.         numnotes = timelen / notelen
  187.     END IF
  188.     REDIM temp(numnotes)
  189.  
  190.     'load and scale notes
  191.         IF UCASE$(RIGHT$(filename$, 3)) = "NOT" THEN
  192.             OPEN filename$ FOR BINARY AS #1
  193.             FOR r = 1 TO numnotes
  194.                 x$ = ""
  195.                 DO
  196.                     x$ = x$ + INPUT$(1, #1)
  197.                     IF EOF(1) THEN EXIT DO
  198.                     IF RIGHT$(x$, 1) = " " THEN EXIT DO
  199.                 LOOP
  200.                 temp(r) = Note2Num(Trim$(x$))
  201.             NEXT
  202.         ELSE
  203.             OPEN filename$ FOR BINARY AS #1
  204.             FOR r = 1 TO numnotes
  205.                 IF LOC(1) = LOF(1) THEN SEEK #1, 1
  206.                 init = ASC(INPUT$(1, #1))
  207.                 temp(r) = ScaleNum(init, 0, 255, notestart, noteend, 0)
  208.             NEXT
  209.         END IF
  210.     CLOSE
  211.  
  212.     'do repeat loop, copying notes to main array
  213.     IF rfilename$ <> "" THEN
  214.         varying = 1
  215.         OPEN rfilename$ FOR BINARY AS #1
  216.     ELSE
  217.         varying = 0
  218.     END IF
  219.     countnotes = 0
  220.     r1 = timestart
  221.     FOR r = 1 TO repeats
  222.         FOR n = 1 TO numnotes
  223.             PRINT ".";
  224.             IF varying THEN
  225.                 vary = ASC(INPUT$(1, #1))
  226.                 note = Modify(temp(n), vary, 0, 255, degreev)
  227.             ELSE
  228.                 note = temp(n)
  229.             END IF
  230.             IF spacing$ = "" THEN
  231.                 r1 = ((r - 1) * numnotes * notelen) + ((n - 1) * notelen) + timestart
  232.             ELSE
  233.                 notelen = LEN(GetWord$(spacing$, ((n - 1) MOD numnotesb) + 1))
  234.             END IF
  235.             r2 = r1 + (notelen - 1)
  236.             rnotes$ = GetNotes$(r1, r2)
  237.             note = Note2Num(Round$(rnotes$, Num2Note$(note), scaletype, size))
  238.             IF spacing$ <> "" THEN
  239.                 IF INSTR(GetWord$(spacing$, ((n - 1) MOD numnotesb) + 1), "o") THEN note = 0
  240.             END IF
  241.             IF note <> 0 THEN
  242.                 countnotes = countnotes + 1
  243.                 al = notes(channel, 1, 0) + countnotes
  244.                 notes(channel, 1, al) = r1
  245.                 notes(channel, 2, al) = note
  246.                 notes(channel, 3, al) = notelen
  247.             END IF
  248.             r1 = r1 + notelen
  249.         NEXT
  250.     NEXT
  251.     notes(channel, 1, 0) = notes(channel, 1, 0) + countnotes
  252.     IF rfilename$ <> "" THEN
  253.         CLOSE
  254.     END IF
  255.     
  256.     ERASE temp
  257. END SUB
  258.  
  259. SUB Arpeg
  260.     CLS
  261.     REDIM as$(3 TO 9)
  262.     PRINT "Dilaudid Glide"
  263.     PRINT "Music Authoring System             (  X: X" + CHR$(34) + " X' X x x' x" + CHR$(34) + " x: x; x= x* )"
  264.     PRINT STRING$(80, "-")
  265.     PRINT
  266.     LINE INPUT "Chord sequence ----->", chords$
  267.     IF INSTR(chords$, "3") THEN LINE INPUT "Arpeggio style 3rd ->", as$(3)
  268.     IF INSTR(chords$, "4") THEN LINE INPUT "Arpeggio style 4th ->", as$(4)
  269.     IF INSTR(chords$, "5") THEN LINE INPUT "Arpeggio style 5th ->", as$(5)
  270.     IF INSTR(chords$, "7") THEN LINE INPUT "Arpeggio style 7th ->", as$(7)
  271.     IF INSTR(chords$, "9") THEN LINE INPUT "Arpeggio style 9th ->", as$(9)
  272.     LINE INPUT "Filename (8 chars) ->", filename$
  273.     PRINT
  274.     LINE INPUT "Proceed? (y/N) ----->", x$
  275.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN ERASE as$: EXIT SUB
  276.     IF filename$ = "" THEN ERASE as$: EXIT SUB
  277.     filename$ = filename$ + ".NOT"
  278.  
  279.     numchords = words(chords$)
  280.  
  281.     OPEN filename$ FOR OUTPUT AS #1
  282.  
  283.     FOR c = 1 TO numchords
  284.         PRINT ".";
  285.         chord$ = GetWord(chords$, c)
  286.         ctype = VAL(RIGHT$(chord$, 1))
  287.         croot = Note2Num(MID$(chord$, 1, LEN(chord$) - 1))
  288.         chord$ = BuildChord$(croot, ctype)
  289.         numnotes = words(as$(ctype))
  290.         FOR n = 1 TO numnotes
  291.             PRINT #1, GetWord$(chord$, VAL(GetWord$(as$(ctype), n))) + " ";
  292.         NEXT
  293.     NEXT
  294.  
  295.     CLOSE
  296.     ERASE as$
  297.  
  298. END SUB
  299.  
  300. FUNCTION BuildChord$ (croot, ctype)
  301.     temp$ = ""
  302.  
  303.     SELECT CASE ctype
  304.         CASE 4
  305.             temp$ = Num2Note$(croot + 0) + " "
  306.             temp$ = temp$ + Num2Note$(croot + 5) + " "
  307.             temp$ = temp$ + Num2Note$(croot + 11) + " "
  308.             temp$ = temp$ + Num2Note$(croot + 16)
  309.         CASE 3, 5, 7, 9
  310.             n = 2 + ((ctype - 3) / 2)
  311.             temp$ = Num2Note$(croot) + " "
  312.             temp$ = temp$ + Num2Note$(croot + 4) + " "
  313.             temp$ = temp$ + Num2Note$(croot + 7) + " "
  314.             IF ctype > 3 THEN temp$ = temp$ + Num2Note$(croot + 11) + " "
  315.             IF ctype > 5 THEN temp$ = temp$ + Num2Note$(croot + 14) + " "
  316.             IF ctype > 7 THEN temp$ = temp$ + Num2Note$(croot + 17)
  317.         END SELECT
  318.  
  319.     BuildChord$ = Trim$(temp$)
  320. END FUNCTION
  321.  
  322. SUB Cellular
  323.     'do a cellular automata generation
  324.  
  325.     CLS
  326.     PRINT "Dilaudid Glide"
  327.     PRINT "Music Authoring System"
  328.     PRINT STRING$(80, "-")
  329.     PRINT
  330.     LINE INPUT "K1 (1-10,2) --------->", k1$
  331.     LINE INPUT "K2 (1-10,3) --------->", k2$
  332.     LINE INPUT "Spd (1-20,4) -------->", spd$
  333.     LINE INPUT "Row start (1-35) ---->", row1$
  334.     LINE INPUT "Number of rows ------>", norow$
  335.     LINE INPUT "Col start (1-35) ---->", col1$
  336.     LINE INPUT "number of cols ------>", nocol$
  337.     LINE INPUT "Time start ---------->", time1$
  338.     LINE INPUT "Duration ------------>", duration$
  339.     LINE INPUT "Random seed --------->", seed$
  340.     LINE INPUT "Output filename (8) ->", filename$
  341.     PRINT
  342.     LINE INPUT "Proceed? (y/N) ----->", x$
  343.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  344.     IF filename$ = "" THEN EXIT SUB
  345.     
  346.     k1 = VAL(k1$)
  347.     k2 = VAL(k2$)
  348.     g = VAL(spd$)   'infection rate
  349.     out$ = filename$ + ".CEL"
  350.     sx = VAL(row1$)
  351.     ex = sx + VAL(norow$) - 1
  352.     sy = VAL(col1$)
  353.     ey = sx + VAL(nocol$) - 1
  354.     time1 = VAL(time1$)
  355.     time2 = time1 + VAL(duration$) - 1
  356.     RANDOMIZE VAL(seed$)
  357.  
  358.     REDIM array1(0 TO 36, 0 TO 36)
  359.     REDIM array2(0 TO 36, 0 TO 36)
  360.  
  361.     FOR r = 1 TO 35
  362.         FOR c = 1 TO 35
  363.             array1(r, c) = (INT(RND * 254))
  364.         NEXT
  365.     NEXT
  366.  
  367.     SCREEN 13
  368.  
  369.     OUT &H3C8, 1
  370.  
  371.     FOR r = 1 TO 127
  372.         OUT &H3C9, (r * 127) \ 254
  373.         OUT &H3C9, 0
  374.         OUT &H3C9, 63 - (r * 127) \ 254
  375.     NEXT
  376.     FOR r = 128 TO 254
  377.         OUT &H3C9, 63 - ((r - 127) * 127) \ 254
  378.         OUT &H3C9, 0
  379.         OUT &H3C9, 0
  380.     NEXT
  381.  
  382.     DEF SEG = &HA000
  383.  
  384.     FOR c = 1 TO 254
  385.         POKE (199 * 320) + c, c
  386.     NEXT
  387.  
  388.     IF out$ <> "" THEN OPEN out$ FOR OUTPUT AS #1
  389.  
  390.     timeat = 0
  391.  
  392.     DO
  393.         timeat = timeat + 1
  394.         IF out$ <> "" AND timeat >= time1 THEN
  395.             FOR r = sx TO ex
  396.                 FOR c = sy TO ey
  397.                     PRINT #1, CHR$((array1(r, c)) + 1);
  398.                 NEXT
  399.             NEXT
  400.         END IF
  401.  
  402.         FOR r = 1 TO 35
  403.             FOR c = 1 TO 35
  404.                 POKE (r * 320) + c, (array1(r, c)) + 1
  405.                 array2(r, c) = array1(r, c)
  406.             NEXT
  407.         NEXT
  408.  
  409.         LINE (sx - 1, sy - 1)-(ex + 1, ey + 1), 0, B
  410.  
  411.         FOR r = 1 TO 35
  412.             FOR c = 1 TO 35
  413.                 IF (array2(r, c)) = 254 THEN           'ill cells
  414.                     array1(r, c) = (0)
  415.                 ELSEIF (array2(r, c)) = 0 THEN       'healthy cells
  416.                     aa = 0: bb = 0
  417.                     IF (array2(r + 1, c)) > 0 AND (array2(r + 1, c)) < 254 THEN aa = 1 ELSE IF (array2(r + 1, c)) = 254 THEN bb = 1
  418.                     IF (array2(r - 1, c)) > 0 AND (array2(r - 1, c)) < 254 THEN aa = aa + 1 ELSE IF (array2(r - 1, c)) = 254 THEN bb = bb + 1
  419.                     IF (array2(r, c + 1)) > 0 AND (array2(r, c + 1)) < 254 THEN aa = aa + 1 ELSE IF (array2(r, c + 1)) = 254 THEN bb = bb + 1
  420.                     IF (array2(r, c - 1)) > 0 AND (array2(r, c - 1)) < 254 THEN aa = aa + 1 ELSE IF (array2(r, c - 1)) = 254 THEN bb = bb + 1
  421.                     array1(r, c) = ((aa \ k1) + (bb \ k2))
  422.                 ELSE                                    'infected cells
  423.                     aa = 0: ss = 0
  424.                     IF (array2(r + 1, c)) > 0 AND (array2(r + 1, c)) < 254 THEN aa = aa + 1: ss = ss + (array2(r + 1, c))
  425.                     IF (array2(r - 1, c)) > 0 AND (array2(r - 1, c)) < 254 THEN aa = aa + 1: ss = ss + (array2(r - 1, c))
  426.                     IF (array2(r, c + 1)) > 0 AND (array2(r, c + 1)) < 254 THEN aa = aa + 1: ss = ss + (array2(r, c + 1))
  427.                     IF (array2(r, c - 1)) > 0 AND (array2(r, c - 1)) < 254 THEN aa = aa + 1: ss = ss + (array2(r, c - 1))
  428.                     IF aa = 0 THEN
  429.                         array1(r, c) = array2(r, c)
  430.                     ELSE
  431.                         array1(r, c) = ((ss \ aa) + g)
  432.                     END IF
  433.                 END IF
  434.                 IF (array1(r, c)) > 254 THEN array1(r, c) = (254)
  435.             NEXT
  436.         NEXT
  437.     LOOP UNTIL timeat > time2
  438.  
  439.     IF out$ <> "" THEN CLOSE
  440.     SCREEN 0
  441.     WIDTH 80
  442.  
  443.     ERASE array1, array2
  444. END SUB
  445.  
  446. SUB DeleteNotes
  447.     'Delete a section of notes
  448.  
  449.     CLS
  450.     PRINT "Dilaudid Glide"
  451.     PRINT "Music Authoring System"
  452.     PRINT STRING$(80, "-")
  453.     PRINT
  454.     LINE INPUT "Channel # ---------->", channel$
  455.     PRINT
  456.     LINE INPUT "Proceed? (y/N) ----->", x$
  457.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  458.  
  459.     channel = VAL(channel$)
  460.     IF channel < 1 THEN channel = 1
  461.     IF channel > 11 THEN channel = 11
  462.  
  463.     'reset topnote
  464.     notes(channel, 1, 0) = 0
  465. END SUB
  466.  
  467. SUB Generate
  468.     CLS
  469.     PRINT "Dilaudid Glide"
  470.     PRINT "Music Authoring System             (  X: X" + CHR$(34) + " X' X x x' x" + CHR$(34) + " x: x; x= x* )"
  471.     PRINT STRING$(80, "-")
  472.     PRINT
  473.     PRINT "1. Cellular"
  474.     PRINT "2. Wave"
  475.     PRINT "3. Random"
  476.     PRINT "4. Mountain range"
  477.     PRINT "5. Life simulation"
  478.     PRINT "6. Arpeggiator"
  479.     PRINT
  480.     LINE INPUT "-->", x$
  481.  
  482.     sel = VAL(x$)
  483.     SELECT CASE sel
  484.         CASE 1  'cellular
  485.             Cellular
  486.         CASE 2  'wave
  487.             Wave
  488.         CASE 3  'random
  489.             RandomNotes
  490.         CASE 4  'mountain range
  491.             Mountain
  492.         CASE 5  'life
  493.             Life
  494.         CASE 6  'Arpeggiator
  495.             Arpeg
  496.     END SELECT
  497. END SUB
  498.  
  499. FUNCTION GetNotes$ (starttime, endtime)
  500.     'Figure out what notes are playing in a specific period of time
  501.  
  502.     FOR chan = 1 TO 11
  503.         top = notes(chan, 1, 0)
  504.         IF top > 0 THEN
  505.             FOR at = 1 TO top
  506.                 timeloc = notes(chan, 1, at)
  507.                 duration = notes(chan, 3, at)
  508.                 noteend = timeloc + (duration - 1)
  509.                 IF (starttime <= timeloc AND endtime >= timeloc) OR (starttime <= noteend AND endtime >= noteend) THEN
  510.                     note$ = note$ + Num2Note(notes(chan, 2, at)) + " "
  511.                 ELSE
  512.                     IF timeloc > endtime THEN EXIT FOR
  513.                 END IF
  514.             NEXT
  515.         END IF
  516.     NEXT
  517.     GetNotes$ = Trim$(note$)
  518. END FUNCTION
  519.  
  520. FUNCTION GetWord$ (orig$, wordno)
  521.     'Get a word from a sentance
  522.  
  523.     IF wordno = 1 THEN
  524.         x = INSTR(orig$, " ")
  525.         IF x = 0 THEN
  526.             t$ = orig$
  527.         ELSE
  528.             t$ = MID$(orig$, 1, x - 1)
  529.         END IF
  530.     ELSE
  531.         t$ = orig$
  532.         at = 2
  533.         DO
  534.             x = INSTR(t$, " ")
  535.             IF x = 0 THEN
  536.                 t$ = ""
  537.                 EXIT DO
  538.             ELSE
  539.                 t$ = MID$(t$, x + 1)
  540.                 IF at = wordno THEN
  541.                     x = INSTR(t$, " ")
  542.                     IF x <> 0 THEN
  543.                         t$ = MID$(t$, 1, x - 1)
  544.                     END IF
  545.                     EXIT DO
  546.                 END IF
  547.             END IF
  548.             at = at + 1
  549.         LOOP
  550.     END IF
  551.     GetWord$ = t$
  552. END FUNCTION
  553.  
  554. SUB Life
  555.     CLS
  556.     PRINT "Dilaudid Glide"
  557.     PRINT "Music Authoring System"
  558.     PRINT STRING$(80, "-")
  559.     PRINT
  560.     LINE INPUT "Row start (1-35) ---->", row1$
  561.     LINE INPUT "Number of rows ------>", norow$
  562.     LINE INPUT "Col start (1-35) ---->", col1$
  563.     LINE INPUT "number of cols ------>", nocol$
  564.     LINE INPUT "Time start ---------->", time1$
  565.     LINE INPUT "Duration ------------>", duration$
  566.     LINE INPUT "Random seed --------->", seed$
  567.     LINE INPUT "Output filename (8) ->", filename$
  568.     PRINT
  569.     LINE INPUT "Proceed? (y/N) ----->", x$
  570.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  571.     IF filename$ = "" THEN EXIT SUB
  572.  
  573.     out$ = filename$ + ".CEL"
  574.     sx = VAL(row1$)
  575.     ex = sx + VAL(norow$) - 1
  576.     sy = VAL(col1$)
  577.     ey = sx + VAL(nocol$) - 1
  578.     time1 = VAL(time1$)
  579.     time2 = time1 + VAL(duration$) - 1
  580.     RANDOMIZE VAL(seed$)
  581.     
  582.     REDIM array1(1 TO 35, 1 TO 35)
  583.     REDIM array2(1 TO 35, 1 TO 35)
  584.     
  585.     SCREEN 13
  586.     CLS
  587.     FOR r = 1 TO 35
  588.         FOR t = 1 TO 35
  589.             x = RND * 256
  590.             array1(r, t) = x
  591.         NEXT
  592.     NEXT
  593.  
  594.     OUT &H3C8, 1
  595.  
  596.     FOR r = 1 TO 127
  597.         OUT &H3C9, (r * 127) \ 254
  598.         OUT &H3C9, 0
  599.         OUT &H3C9, 63 - (r * 127) \ 254
  600.     NEXT
  601.     FOR r = 128 TO 254
  602.         OUT &H3C9, 63 - ((r - 127) * 127) \ 254
  603.         OUT &H3C9, 0
  604.         OUT &H3C9, 0
  605.     NEXT
  606.  
  607.     DEF SEG = &HA000
  608.  
  609.     IF out$ <> "" THEN OPEN out$ FOR OUTPUT AS #1
  610.  
  611.     timeat = 0
  612.  
  613.     DO
  614.         FOR r = 1 TO 35
  615.             FOR t = 1 TO 35
  616.                 orig = array1(r, t)
  617.                 ab = r - 1: IF ab = 0 THEN ab = 35
  618.                 bl = r + 1: IF bl = 36 THEN bl = 1
  619.                 lt = t + 1: IF lt = 36 THEN lt = 1
  620.                 rt = t - 1: IF rt = 0 THEN rt = 35
  621.                 avgn = (array1(ab, t) + array1(bl, t) + array1(r, lt) + array1(r, rt)) \ 4
  622.                 IF orig < 251 AND orig > 9 THEN
  623.                     SELECT CASE avgn
  624.                         CASE IS > 230
  625.                             orig = orig \ 3 + avgn \ 2
  626.                         CASE 80 TO 229
  627.                             orig = (orig * 2 + avgn) \ 3
  628.                         CASE ELSE
  629.                             orig = (orig + avgn * 2) \ 3
  630.                     END SELECT
  631.                 END IF
  632.                 IF orig > 130 THEN orig = orig + 4 ELSE orig = orig - 2
  633.                 IF orig <= 0 THEN orig = 255
  634.                 IF orig > 255 THEN orig = 255
  635.                 IF orig < 10 THEN
  636.                     array1(r, lt) = ((array1(r, lt) + 44) + array1(ab, lt)) \ 2
  637.                     IF array1(r, lt) > 255 THEN array1(r, lt) = 255
  638.                     array1(r, rt) = ((array1(r, rt) + 44) + array1(ab, rt)) \ 2
  639.                     IF array1(r, rt) > 255 THEN array1(r, rt) = 255
  640.                     array2(r, rt) = array1(r, rt)
  641.                     array2(r, lt) = array1(r, lt)
  642.                 END IF
  643.                 IF orig > 250 THEN
  644.                     array1(ab, t) = ((array1(ab, t) \ 3) + array1(ab, lt)) \ 2
  645.                     array1(bl, t) = ((array1(bl, t) \ 3) + array1(bl, lt)) \ 2
  646.                     array2(ab, t) = array1(ab, t)
  647.                     array2(bl, t) = array1(bl, t)
  648.                 END IF
  649.                 array2(r, t) = orig
  650.             NEXT
  651.         NEXT
  652.  
  653.         FOR r = 1 TO 35
  654.             FOR c = 1 TO 35
  655.                 'POKE (r * 320) + c, (array2(r, c)) + 1
  656.                 PSET (c, r), (array2(r, c)) + 1
  657.                 array1(r, c) = array2(r, c)
  658.             NEXT
  659.         NEXT
  660.  
  661.         LINE (sx - 1, sy - 1)-(ex + 1, ey + 1), 0, B
  662.  
  663.         timeat = timeat + 1
  664.         IF out$ <> "" AND timeat >= time1 THEN
  665.             FOR r = sx TO ex
  666.                 FOR c = sy TO ey
  667.                     PRINT #1, CHR$((array1(r, c)));
  668.                 NEXT
  669.             NEXT
  670.         END IF
  671.     LOOP UNTIL timeat > time2
  672.  
  673.     SCREEN 0
  674.     WIDTH 80
  675.  
  676.     CLOSE
  677.     ERASE array1, array2
  678.  
  679. END SUB
  680.  
  681. SUB Load
  682.     'Load a sequence array
  683.     x$ = DIR$("*.DGS")
  684.     IF x$ <> "" THEN
  685.         PRINT x$,
  686.         DO
  687.             x$ = DIR$
  688.             IF x$ = "" THEN EXIT DO
  689.             PRINT x$,
  690.         LOOP
  691.     END IF
  692.     PRINT
  693.     
  694.     LINE INPUT "Filename (8 chars) -->", filename$
  695.     filename$ = Trim$(filename$)
  696.     IF filename$ = "" THEN EXIT SUB
  697.     LINE INPUT "Are you sure (y/N) -->", x$
  698.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  699.     filename$ = filename$ + ".DGS"
  700.     OPEN filename$ FOR BINARY AS #1
  701.         FOR r1 = 1 TO 11
  702.             PRINT ".";
  703.             FOR r2 = 1 TO 3
  704.                 FOR r3 = 0 TO 500
  705.                     notes(r1, r2, r3) = CVI(INPUT$(2, #1))
  706.                 NEXT
  707.             NEXT
  708.         NEXT
  709.     CLOSE #1
  710. END SUB
  711.  
  712. FUNCTION Modify (initial, change, irlo, irhi, degree)
  713.     'takes a note INITIAL, and a CHANGE value in the
  714.     'range IRLO-IRHI, and modifies INITIAL up to DEGREE
  715.     'steps
  716.  
  717.     top = (irhi - irlo) / 2
  718.     temp = (change - irlo) - top    'from - to + range
  719.     chng = (temp / top) * degree    'calculate change
  720.  
  721.     Modify = initial + chng
  722.  
  723. END FUNCTION
  724.  
  725. SUB Mountain
  726.     'generate a mountain range pattern
  727.  
  728.     CLS
  729.     PRINT "Dilaudid Glide"
  730.     PRINT "Music Authoring System"
  731.     PRINT STRING$(80, "-")
  732.     PRINT
  733.     LINE INPUT "% conjunct jumps ---------->", conjunct$
  734.     LINE INPUT "% disjunct jumps ---------->", disjunct$
  735.     conjunct = VAL(conjunct$)
  736.     disjunct = VAL(disjunct$)
  737.     nonjunct = 100 - (conjunct + disjunct)
  738.     PRINT "% 'nonjunct' jumps -------->"; Trim$(STR$(nonjunct))
  739.     LINE INPUT "Conjunct jump size -------->", consize$
  740.     LINE INPUT "Disjunct jump size -------->", dissize$
  741.     consize = VAL(consize$)
  742.     dissize = VAL(dissize$)
  743.     LINE INPUT "Number of pattern buffers ->", nobuf$
  744.     nobuf = VAL(nobuf$)
  745.     IF nobuf THEN
  746.         LINE INPUT "Max size of buffer -------->", maxsize$
  747.         DIM patbuf(1 TO nobuf, -4 TO VAL(maxsize$))
  748.                 '-4 = relative (-1=note,else=start pt)
  749.                 '-3 = size
  750.                 '-2 = start rec chance
  751.                 '-1 = start play size
  752.                 ' 0 = beat lock
  753.         FOR r = 1 TO nobuf
  754.             PRINT "==BUFFFER " + Trim$(STR$(r)) + "=="
  755.             LINE INPUT "   Buffer size ------------>", size$
  756.             LINE INPUT "   Relative/Absolute (ra) ->", relabs$
  757.             LINE INPUT "   Start record chance ---->", src$
  758.             LINE INPUT "   Start play chance ------>", scpc$
  759.             LINE INPUT "   Beat lock -------------->", bl$
  760.             IF MID$(LCASE$(relabs$), 1, 1) = "r" THEN patbuf(r, -4) = -1 ELSE patbuf(r, -4) = (RND * 128) + 64
  761.             patbuf(r, -3) = VAL(size$)
  762.             patbuf(r, -2) = VAL(src$)
  763.             patbuf(r, -1) = VAL(scpc$)
  764.             patbuf(r, 0) = VAL(bl$)
  765.         NEXT
  766.     END IF
  767.     LINE INPUT "Seed ---------------------->", seed$
  768.     RANDOMIZE VAL(seed$)
  769.     LINE INPUT "Length -------------------->", length$
  770.     length = VAL(length$)
  771.     LINE INPUT "Filename (8 chars) -------->", filename$
  772.     PRINT
  773.     LINE INPUT "Proceed? (y/N) ------------>", x$
  774.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  775.     IF filename$ = "" THEN EXIT SUB
  776.     filename$ = filename$ + ".CEL"
  777.  
  778.     dir = RND * 2: pb = 0: pbloc = 0: pbbuf = 0
  779.     note = 128: rec = 0: recloc = 0: recbuf = 0
  780.  
  781.     SCREEN 12
  782.  
  783.     OPEN filename$ FOR OUTPUT AS #1
  784.  
  785.     FOR r = 1 TO nobuf  'fill pattern buffers first
  786.         dir = RND * 2
  787.         FOR t = 1 TO patbuf(r, -3)
  788.             x = (RND * 100) + 1
  789.             SELECT CASE x
  790.                 CASE 1 TO conjunct  'conjunct
  791.                     change = RND * consize
  792.                 CASE (conjunct + 1) TO (disjunct + conjunct + 1)    'disjunct
  793.                     change = RND * dissize
  794.                     IF dir THEN dir = 0 ELSE dir = 1
  795.                 CASE ELSE           'nonjunct
  796.                     change = 0
  797.             END SELECT
  798.             IF dir = 0 THEN change = -change
  799.             patbuf(r, t) = change
  800.         NEXT
  801.     NEXT
  802.  
  803.     FOR r = 1 TO length
  804.         IF pb THEN
  805.             change = patbuf(pbbuf, pbloc)
  806.             pbloc = pbloc + 1
  807.             IF pbloc > patbuf(pbbuf, -3) THEN
  808.                 pb = 0: pbloc = 0: pbbuf = 0
  809.             END IF
  810.         ELSE
  811.             x = (RND * 100) + 1
  812.             SELECT CASE x
  813.                 CASE 1 TO conjunct  'conjunct
  814.                     change = RND * consize
  815.                 CASE (conjunct + 1) TO (disjunct + conjunct + 1)    'disjunct
  816.                     change = RND * dissize
  817.                     IF dir THEN dir = 0 ELSE dir = 1
  818.                 CASE ELSE           'nonjunct
  819.                     change = 0
  820.             END SELECT
  821.             IF dir = 0 THEN change = -change
  822.             FOR t = 1 TO nobuf
  823.                 B = (r + 1) MOD patbuf(t, 0)
  824.                 IF B = 0 AND recbuf <> t THEN
  825.                     IF (RND * 100) < patbuf(t, -2) THEN
  826.                         rec = 1: recbuf = t: recloc = 1
  827.                         IF patbuf(t, -4) > -1 THEN
  828.                             patbuf(t, -4) = note
  829.                         END IF
  830.                         EXIT FOR
  831.                     END IF
  832.                 END IF
  833.             NEXT
  834.         END IF
  835.         note = note + change
  836.         IF note > 255 THEN note = 255
  837.         IF note < 0 THEN note = 0
  838.         PRINT #1, CHR$(note);
  839.         LINE (r MOD 640, 0)-(r MOD 640, 255), 0
  840.         PSET (r MOD 640, note), 15
  841.  
  842.         IF rec THEN
  843.             patbuf(recbuf, recloc) = change
  844.             recloc = recloc + 1
  845.             IF recloc > patbuf(recbuf, -3) THEN
  846.                 rec = 0: recloc = 0: recbuf = 0
  847.             END IF
  848.         ELSE
  849.             FOR t = 1 TO nobuf
  850.                 B = (r + 1) MOD patbuf(t, 0)
  851.                 IF B = 0 AND pbbuf <> t THEN
  852.                     IF (RND * 100) < patbuf(t, -1) THEN
  853.                         pb = 1: pbbuf = t: pbloc = 1
  854.                         IF patbuf(t, -4) > -1 THEN
  855.                             note = patbuf(t, -4)
  856.                         END IF
  857.                         EXIT FOR
  858.                     END IF
  859.                 END IF
  860.             NEXT
  861.         END IF
  862.     NEXT
  863.     CLOSE #1
  864.     LOCATE 30, 1
  865.     PRINT "--Press any key to return to menu--";
  866.  
  867.     DO UNTIL INKEY$ <> "": LOOP
  868.     SCREEN 0
  869. END SUB
  870.  
  871. SUB Move
  872.     'Delete a section of notes
  873.  
  874.     CLS
  875.     PRINT "Dilaudid Glide"
  876.     PRINT "Music Authoring System"
  877.     PRINT STRING$(80, "-")
  878.     PRINT
  879.     LINE INPUT "Channel # (0=ALL) -->", channel$
  880.     LINE INPUT "Distance ----------->", dist$
  881.     PRINT
  882.     LINE INPUT "Proceed? (y/N) ----->", x$
  883.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  884.  
  885.     c = VAL(channel$)
  886.     d = VAL(dist$) * 16
  887.     IF c = 0 THEN
  888.         c1 = 1: c2 = 11
  889.     ELSE
  890.         c1 = c: c2 = c
  891.     END IF
  892.  
  893.     FOR c = c1 TO c2
  894.         PRINT ".";
  895.         nn = notes(c, 1, 0)
  896.         FOR n = 1 TO nn
  897.             notes(c, 1, n) = notes(c, 1, n) + d
  898.         NEXT
  899.     NEXT
  900.  
  901. END SUB
  902.  
  903. FUNCTION Note2Num (note$)
  904.     'converts a note string into a number 0-127
  905.     'note names range X: X" X' X x x' x" x: x; x= x*
  906.     'note number 60 is middle C (c')
  907.     
  908.     SELECT CASE LCASE$(MID$(note$, 1, 1))
  909.         CASE "c"
  910.             basen = 0
  911.         CASE "d"
  912.             basen = 2
  913.         CASE "e"
  914.             basen = 4
  915.         CASE "f"
  916.             basen = 5
  917.         CASE "g"
  918.             basen = 7
  919.         CASE "a"
  920.             basen = 9
  921.         CASE "b"
  922.             basen = 11
  923.         CASE ELSE
  924.             Note2Num = 0
  925.             EXIT FUNCTION
  926.     END SELECT
  927.     IF INSTR(note$, "+") THEN basen = basen + 1
  928.  
  929.     IF ASC(MID$(note$, 1, 1)) < 75 THEN
  930.         SELECT CASE RIGHT$(note$, 1)
  931.             CASE ":"
  932.                 octave = 0
  933.             CASE CHR$(34)
  934.                 octave = 1
  935.             CASE "'"
  936.                 octave = 2
  937.             CASE ELSE
  938.                 octave = 3
  939.         END SELECT
  940.     ELSE
  941.         SELECT CASE RIGHT$(note$, 1)
  942.             CASE "'"
  943.                 octave = 5
  944.             CASE CHR$(34)
  945.                 octave = 6
  946.             CASE ":"
  947.                 octave = 7
  948.             CASE ";"
  949.                 octave = 8
  950.             CASE "="
  951.                 octave = 9
  952.             CASE "*"
  953.                 octave = 10
  954.             CASE ELSE
  955.                 octave = 4
  956.         END SELECT
  957.     END IF
  958.  
  959.     Note2Num = (octave * 12) + basen
  960.  
  961. END FUNCTION
  962.  
  963. FUNCTION Num2Note$ (number)
  964.     'converts a number 0-127 into a note name string
  965.     'note names range X: X" X' X x x' x" x: x; x= x*
  966.     'note number 60 is middle C (c')
  967.  
  968.     uc = 0      'upper case toggle
  969.     foot$ = ""  'footer
  970.     SELECT CASE number
  971.         CASE 0 TO 11    '   C: to B:
  972.             uc = 1: foot$ = ":"
  973.         CASE 12 TO 23   '   C" to B"
  974.             uc = 1: foot$ = CHR$(34)
  975.         CASE 24 TO 35   '   C' to B'
  976.             uc = 1: foot$ = "'"
  977.         CASE 36 TO 47   '   C to B
  978.             uc = 1
  979.         CASE 48 TO 59   '   c to b
  980.         CASE 60 TO 71   '   c' to b'
  981.             foot$ = "'"
  982.         CASE 72 TO 83   '   c" to b"
  983.             foot$ = CHR$(34)
  984.         CASE 84 TO 95   '   c: to b:
  985.             foot$ = ":"
  986.         CASE 96 TO 107  '   c; to b;
  987.             foot$ = ";"
  988.         CASE 108 TO 119 '   c= to b=
  989.             foot$ = "="
  990.         CASE 120 TO 127 '   c* to g*
  991.             foot$ = "*"
  992.     END SELECT
  993.     SELECT CASE (number MOD 12)
  994.         CASE 0
  995.             note$ = "c"
  996.         CASE 1
  997.             note$ = "c+"
  998.         CASE 2
  999.             note$ = "d"
  1000.         CASE 3
  1001.             note$ = "d+"
  1002.         CASE 4
  1003.             note$ = "e"
  1004.         CASE 5
  1005.             note$ = "f"
  1006.         CASE 6
  1007.             note$ = "f+"
  1008.         CASE 7
  1009.             note$ = "g"
  1010.         CASE 8
  1011.             note$ = "g+"
  1012.         CASE 9
  1013.             note$ = "a"
  1014.         CASE 10
  1015.             note$ = "a+"
  1016.         CASE 11
  1017.             note$ = "b"
  1018.     END SELECT
  1019.     IF uc = 1 THEN note$ = UCASE$(note$)
  1020.     Num2Note$ = note$ + foot$
  1021. END FUNCTION
  1022.  
  1023. SUB Quit
  1024.     'Quit program
  1025.  
  1026.     LINE INPUT "Are you sure (y/N) -->", x$
  1027.     IF LCASE$(LEFT$(x$, 1)) = "y" THEN
  1028.         CLS
  1029.         END
  1030.     END IF
  1031. END SUB
  1032.  
  1033. SUB RandomNotes
  1034.     CLS
  1035.     PRINT "Dilaudid Glide"
  1036.     PRINT "Music Authoring System             (  X: X" + CHR$(34) + " X' X x x' x" + CHR$(34) + " x: x; x= x* )"
  1037.     PRINT STRING$(80, "-")
  1038.     PRINT
  1039.     LINE INPUT "Number of notes ---->", numnotes$
  1040.     LINE INPUT "Seed --------------->", seed$
  1041.     LINE INPUT "Filename (8 chars) ->", filename$
  1042.     PRINT
  1043.     LINE INPUT "Proceed? (y/N) ----->", x$
  1044.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  1045.     IF filename$ = "" THEN EXIT SUB
  1046.  
  1047.     numnotes = VAL(numnotes$)
  1048.     RANDOMIZE VAL(seed$)
  1049.     filename$ = filename$ + ".CEL"
  1050.  
  1051.     OPEN filename$ FOR OUTPUT AS #1
  1052.     FOR r = 1 TO numnotes
  1053.         PRINT #1, CHR$(INT(RND * 256));
  1054.     NEXT
  1055.     CLOSE
  1056. END SUB
  1057.  
  1058. FUNCTION Round$ (initial$, newnote1$, scaletype, size)
  1059.     'given the INITIAL$ notes, NEWNOTE1$ is frequency
  1060.     'quantized to make it harmonize with these notes
  1061.  
  1062.     available1$ = "c c+d d+e f f+g g+a a+b "
  1063.     octaves$ = "X:X" + CHR$(34) + "X'X x x'x" + CHR$(34) + "x:x;x=x*"
  1064.     
  1065.     'modify available$ to change key/scale
  1066.     SELECT CASE scaletype
  1067.         CASE 0  'chromatic
  1068.             available$ = "c c+d d+e f f+g g+a a+b "
  1069.         CASE 1  'whole tone starting on C
  1070.             available$ = "c   d   e   f+  g+  a+  "
  1071.         CASE 2  'whole tone starting on C+
  1072.             available$ = "  c+  d+  f   g   a   b "
  1073.         CASE 3  'diatonic/c-major
  1074.             available$ = "c   d   e f   g   a   b "
  1075.         CASE 4  'spooky
  1076.             available$ = "c   d d+  f   g g+  a+  "
  1077.         CASE 5  'black keys
  1078.             available$ = "  c+  d+    f+  g+  a+  "
  1079.         CASE 6  'indian
  1080.             available$ = "c c+  d+e   f+g   a a+  "
  1081.         CASE ELSE
  1082.             available$ = "c c+d d+e f f+g g+a a+b "
  1083.     END SELECT
  1084.  
  1085.     'go through all the notes in initial$ and take out
  1086.     'all of their 'neighbors' in available$
  1087.     at = 0
  1088.     DO
  1089.         at = at + 1
  1090.         curnote1$ = GetWord$(initial$, at)
  1091.         IF curnote1$ = "" THEN EXIT DO
  1092.         curnote$ = LCASE$(MID$(curnote1$, 1, 1))
  1093.         IF INSTR(curnote1$, "+") THEN curnote$ = curnote$ + "+" ELSE curnote$ = curnote$ + " "
  1094.         x = INSTR(available1$, curnote$)
  1095.         FOR r = 1 TO size
  1096.             d1 = x - (2 * r)
  1097.             IF d1 < 1 THEN d1 = d1 + 24
  1098.             MID$(available$, d1, 2) = "  "
  1099.             d1 = x + (2 * r)
  1100.             IF d1 > 23 THEN d1 = d1 - 24
  1101.             MID$(available$, d1, 2) = "  "
  1102.         NEXT
  1103.     LOOP
  1104.  
  1105.     'now available$ has been cleared of clearly illegal
  1106.     'notes and can be scanned for best fit
  1107.  
  1108.     'make newnote1$ into a "featureless" note (newnote$)
  1109.     newnote$ = LCASE$(MID$(newnote1$, 1, 1))
  1110.     IF INSTR(newnote1$, "+") THEN newnote$ = newnote$ + "+" ELSE newnote$ = newnote$ + " "
  1111.  
  1112.     'make a string, three octaves long
  1113.     'if bottom octave, first string all spaces
  1114.     'if top octave, third string all spaces
  1115.     IF ASC(MID$(newnote1$, 1, 1)) < 72 AND INSTR(newnote1$, CHR$(34)) THEN s1$ = SPACE$(24) ELSE s1$ = available$
  1116.     IF INSTR(newnote1$, "*") THEN s3$ = SPACE$(24) ELSE s3$ = available$
  1117.     scan$ = s1$ + available$ + s3$
  1118.  
  1119.     'locate start point in second octave set
  1120.     startloc = INSTR(available1$, newnote$) + 24
  1121.  
  1122.     'check if note is already ok. if so, keep and exit
  1123.     IF Trim$(MID$(scan$, startloc, 2)) <> "" THEN
  1124.         Round$ = newnote1$
  1125.         EXIT FUNCTION
  1126.     END IF
  1127.  
  1128.     'scan up one, down one, until a non blank is hit
  1129.     offset = 2
  1130.     DO
  1131.         IF startloc + offset < LEN(scan$) THEN
  1132.             IF Trim$(MID$(scan$, startloc + offset, 2)) <> "" THEN
  1133.                 foundat = startloc + offset
  1134.                 GOTO found
  1135.             END IF
  1136.         END IF
  1137.         IF startloc - offset > 0 THEN
  1138.             IF Trim$(MID$(scan$, startloc - offset, 2)) <> "" THEN
  1139.                 foundat = startloc - offset
  1140.                 GOTO found
  1141.             END IF
  1142.         END IF
  1143.         offset = offset + 2
  1144.         IF offset > 100 THEN
  1145.             Round$ = "": EXIT FUNCTION
  1146.         END IF
  1147.     LOOP
  1148.  
  1149.     'when note is hit, grab octave, check for case change,
  1150.     'write new note, and exit
  1151.     '                   X:X"X'X x x'x"x:x;x=x*
  1152. found:
  1153.     IF ASC(MID$(newnote1$, 1, 1)) < 72 THEN octscan$ = "X" ELSE octscan$ = "x"
  1154.     IF RIGHT$(newnote1$, 1) <> "+" AND LEN(newnote1$) <> 1 THEN octscan$ = octscan$ + RIGHT$(newnote1$, 1) ELSE octscan$ = octscan$ + " "
  1155.     curoct = INSTR(octaves$, octscan$)
  1156.     IF foundat < 25 THEN
  1157.         curoct = curoct - 2
  1158.     ELSEIF foundat > 48 THEN
  1159.         curoct = curoct + 2
  1160.     END IF
  1161.     IF curoct < 1 THEN curoct = 1
  1162.     newnote$ = Trim$(MID$(scan$, foundat, 2))
  1163.     IF MID$(octaves$, curoct, 1) = "X" THEN newnote$ = UCASE$(newnote$)
  1164.     Round$ = Trim$(newnote$ + MID$(octaves$, curoct + 1, 1))
  1165.  
  1166. END FUNCTION
  1167.  
  1168. SUB Save
  1169.     'Save the sequence array
  1170.     x$ = DIR$("*.DGS")
  1171.     IF x$ <> "" THEN
  1172.         PRINT x$,
  1173.         DO
  1174.             x$ = DIR$
  1175.             IF x$ = "" THEN EXIT DO
  1176.             PRINT x$,
  1177.         LOOP
  1178.     END IF
  1179.     PRINT
  1180.  
  1181.     LINE INPUT "Filename (8 chars) -->", filename$
  1182.     filename$ = Trim$(filename$)
  1183.     IF filename$ = "" THEN EXIT SUB
  1184.     filename$ = filename$ + ".DGS"
  1185.     OPEN filename$ FOR OUTPUT AS #1
  1186.         FOR r1 = 1 TO 11
  1187.             PRINT ".";
  1188.             FOR r2 = 1 TO 3
  1189.                 FOR r3 = 0 TO 500
  1190.                     PRINT #1, MKI$(notes(r1, r2, r3));
  1191.                 NEXT
  1192.             NEXT
  1193.         NEXT
  1194.     CLOSE #1
  1195. END SUB
  1196.  
  1197. SUB SaveText (filename$)
  1198.     IF filename$ = "" THEN
  1199.         LINE INPUT "Filename (8 chars) -->", filename$
  1200.         filename$ = Trim$(filename$)
  1201.         IF filename$ = "" THEN EXIT SUB
  1202.         filename$ = filename$ + ".TXT"
  1203.     END IF
  1204.     
  1205.     OPEN filename$ FOR OUTPUT AS #1
  1206.  
  1207.     'find top timeloc
  1208.     top = 0
  1209.     FOR r = 1 TO 11
  1210.         topc = notes(r, 1, 0)
  1211.         IF topc <> 0 THEN
  1212.             topc = notes(r, 1, topc) + notes(r, 3, topc)
  1213.         END IF
  1214.         IF topc > top THEN top = topc
  1215.     NEXT
  1216.  
  1217.     REDIM last(1 TO 11)
  1218.     FOR c = 1 TO 11: last(c) = 0: NEXT
  1219.  
  1220.     IF filename$ <> "SEQ.TXT" THEN PRINT #1, "0-----1-----2-----3-----4-----5-----6-----7-----8-----9-----10---- 1"
  1221.     FOR t = 1 TO top
  1222.         temp$ = ""
  1223.         FOR c = 1 TO 11
  1224.             'check note starts at chan c, time t
  1225.             'check note ends at chan c, time t
  1226.             'or blank
  1227.             IF last(c) <= notes(c, 1, 0) THEN
  1228.                     sn = last(c) + 1
  1229.                     timeloc = notes(c, 1, sn)
  1230.                     noteend = notes(c, 1, last(c)) + notes(c, 3, last(c))
  1231.                     IF timeloc = t AND last(c) < notes(c, 1, 0) THEN
  1232.                         x$ = Num2Note$(notes(c, 2, sn))
  1233.                         n$ = "   "
  1234.                         LSET n$ = x$
  1235.                         temp$ = temp$ + n$
  1236.                         last(c) = last(c) + 1
  1237.                     ELSEIF noteend = t THEN
  1238.                         temp$ = temp$ + "***"
  1239.                     ELSE
  1240.                         temp$ = temp$ + "   "
  1241.                     END IF
  1242.                     IF filename$ <> "SEQ.TXT" THEN temp$ = temp$ + " | "
  1243.             ELSE
  1244.                 temp$ = temp$ + "***"
  1245.             END IF
  1246.         NEXT
  1247.         IF filename$ <> "SEQ.TXT" THEN temp$ = RTRIM$(temp$) + HEX$((t - 1) MOD 16)
  1248.         PRINT #1, temp$
  1249.         IF t MOD 16 = 0 THEN
  1250.             IF filename$ <> "SEQ.TXT" THEN PRINT #1, "0-----1-----2-----3-----4-----5-----6-----7-----8-----9-----10----"; ((t \ 16) + 1)
  1251.         END IF
  1252.     NEXT
  1253.     
  1254.     CLOSE #1
  1255.     ERASE last
  1256. END SUB
  1257.  
  1258. FUNCTION ScaleNum (initial, irlo, irhi, orlo, orhi, inv)
  1259.     'rescales an INITIAL number, range IRLO-IRHI to a
  1260.     'number in the range ORLO-ORHI. if boolean INV is
  1261.     'true, then the conversion is inverted
  1262.  
  1263.     top = irhi - irlo
  1264.     temp = initial - irlo   'temp is in range 0-top
  1265.  
  1266.     IF inv THEN temp = top - temp    'invert if needed
  1267.  
  1268.     newtop = orhi - orlo
  1269.  
  1270.     ScaleNum = orlo + ((newtop / top) * temp)
  1271. END FUNCTION
  1272.  
  1273. FUNCTION Trim$ (orig$)
  1274.     Trim$ = LTRIM$(RTRIM$(orig$))
  1275. END FUNCTION
  1276.  
  1277. SUB ViewComp
  1278.     'find top timeloc
  1279.     top = 0
  1280.     FOR r = 1 TO 11
  1281.         topc = notes(r, 1, 0)
  1282.         IF topc <> 0 THEN
  1283.             topc = notes(r, 1, topc) + notes(r, 3, topc)
  1284.         END IF
  1285.         IF topc > top THEN top = topc
  1286.     NEXT
  1287.     IF top = 0 THEN top = 640
  1288.     mult# = 639 / top
  1289.     PRINT mult#
  1290.  
  1291.     SCREEN 12
  1292.     FOR r = 0 TO 11
  1293.         LINE (0, (r * 24) + 5)-(639, (r * 24) + 5), 1
  1294.     NEXT
  1295.     FOR r = 1 TO top + 16 STEP 16
  1296.         r1 = (mult# * r) - 1
  1297.         LINE (r1, 5)-(r1, 269), 1
  1298.     NEXT
  1299.     LINE (639, 5)-(639, 269), 1
  1300.     
  1301.     FOR c = 1 TO 11
  1302.         col = 16 - c
  1303.         IF col < 9 THEN col = col - 1
  1304.         FOR n = 1 TO notes(c, 1, 0)
  1305.             r1 = (mult# * (notes(c, 1, n))) - 1
  1306.             r2 = (mult# * ((notes(c, 1, n)) + (notes(c, 3, n)) - 1)) - 1
  1307.             v = 250 - (notes(c, 2, n) * 2)
  1308.             LINE (r1, v)-(r2, v), col
  1309.         NEXT
  1310.     NEXT
  1311.     LOCATE 30, 1
  1312.     PRINT "--Press any key to return to menu--";
  1313.     
  1314.     DO UNTIL INKEY$ <> "": LOOP
  1315.     SCREEN 0
  1316. END SUB
  1317.  
  1318. SUB Wave
  1319.     CLS
  1320.     PRINT "Dilaudid Glide"
  1321.     PRINT "Music Authoring System             (  X: X" + CHR$(34) + " X' X x x' x" + CHR$(34) + " x: x; x= x* )"
  1322.     PRINT STRING$(80, "-")
  1323.     PRINT
  1324.     PRINT "Wave type:"
  1325.     PRINT "   /     \         /\          -"
  1326.     PRINT "  /|     |\       /  \       /   \"
  1327.     PRINT " / |     | \     /    \     |     |"
  1328.     PRINT "/  |     |  \   /      \  _/       \_"
  1329.     PRINT "1.UP     2.DN   3.TRI      4.SINE"
  1330.     PRINT
  1331.     LINE INPUT "Wave type ---------->", WaveType$
  1332.     LINE INPUT "Notes/cycle -------->", notesper$
  1333.     LINE INPUT "Number of cycles --->", nocycles$
  1334.     LINE INPUT "Filename (8 chars) ->", filename$
  1335.     PRINT
  1336.     LINE INPUT "Proceed? (y/N) ----->", x$
  1337.     IF LCASE$(LEFT$(x$, 1)) <> "y" THEN EXIT SUB
  1338.     IF filename$ = "" THEN EXIT SUB
  1339.  
  1340.     WaveType = VAL(WaveType$)
  1341.     notesper = VAL(notesper$)
  1342.     nocycles = VAL(nocycles$)
  1343.     filename$ = filename$ + ".CEL"
  1344.  
  1345.     OPEN filename$ FOR OUTPUT AS #1
  1346.  
  1347.     FOR c = 1 TO nocycles
  1348.         SELECT CASE WaveType
  1349.             CASE 1  'up triangle wave
  1350.                 FOR n = 1 TO notesper
  1351.                     x = ScaleNum(n, 1, notesper, 0, 255, 0)
  1352.                     PRINT #1, CHR$(x);
  1353.                 NEXT
  1354.             CASE 2  'down triangle wave
  1355.                 FOR n = notesper TO 1 STEP -1
  1356.                     x = ScaleNum(n, 1, notesper, 0, 255, 0)
  1357.                     PRINT #1, CHR$(x);
  1358.                 NEXT
  1359.             CASE 3  'full triangle wave
  1360.                 n2 = notesper \ 2
  1361.                 FOR n = 1 TO n2
  1362.                     x = ScaleNum(n, 1, n2, 0, 255, 0)
  1363.                     PRINT #1, CHR$(x);
  1364.                 NEXT
  1365.                 r1 = ScaleNum(2, 1, n2, 0, 255, 0)
  1366.                 r2 = ScaleNum(n2 - 1, 1, n2, 0, 255, 0)
  1367.                 FOR n = (notesper \ 2) TO 1 STEP -1
  1368.                     x = ScaleNum(n, 1, n2, r1, r2, 0)
  1369.                     PRINT #1, CHR$(x);
  1370.                 NEXT
  1371.             CASE 4  'sine wave
  1372.                 FOR n = 1 TO notesper
  1373.                     n2# = ((n - 1) / (notesper - 1)) * 6.2
  1374.                     x2# = SIN(n2#)
  1375.                     x = (x2# + 1) * 127
  1376.                     PRINT #1, CHR$(x);
  1377.                 NEXT
  1378.         END SELECT
  1379.     NEXT
  1380.  
  1381.     CLOSE
  1382. END SUB
  1383.  
  1384. FUNCTION words (text$)
  1385.         temp = 1
  1386.         FOR r = 1 TO LEN(text$)
  1387.             IF MID$(text$, r, 1) = " " THEN temp = temp + 1
  1388.         NEXT
  1389.         words = temp
  1390. END FUNCTION
  1391.  
  1392.